perm filename LS.SAI[SAI,BGB] blob
sn#107848 filedate 1974-06-20 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00014 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 BEGIN "LS"
C00005 00003 SUBR ROTATE(REFERENCE REAL X,Y REAL Q)
C00006 00004 SUBR MKCAMR α COSINES BETWEEN CAMERA RAYS
C00008 00005 SUBR MKFORK α INITIAL DIRECTION COSINES OF CAMERA RAYS
C00010 00006 SUBR SETFORK (REAL W1,W2,W3)
C00012 00007 SUBR SKEW (REAL MX,MY,MZ,NX,NY,NZ)
C00013 00008 SUBR MKFORCE α FIND CLOSEST POINTS OF CORRESPONDING SKEW RAYS
C00015 00009 SUBR TORQUE (REAL W1,W2,W3)
C00017 00010 REAL SUBR QQ(REAL W1,W2,W3)
C00022 00011 SUBR TORKUP
C00024 00012 SUBR CLIMB
C00026 00013 PROCEDURE SAMPLER
C00027 00014 BEGIN "MAIN" α MAIN EXECUTION
C00028 ENDMK
C⊗;
BEGIN "LS"
REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
α SOLUTION TO TEST CASE;
REAL C1X,C1Y,C1Z;
REAL C2X,C2Y,C2Z;
REAL WW1,WW2,WW3;
α TWO CAMERA FORKS;
REAL SS1,SS2,RR1,RR2; α CAMERA CIRCLE CENTERS & RADII;
REAL α1,α2,MS12,NS12; α ANGLE BETWEEN FIRST TWO RAYS;
REAL MC12,MC13,MC14,MC15,MC23,MC24,MC25,MC34,MC35,MC45;
REAL NC12,NC13,NC14,NC15,NC23,NC24,NC25,NC34,NC35,NC45;
REAL MSIGN3,MSIGN4,MSIGN5,NSIGN3,NSIGN4,NSIGN5;
α POSITION DIRECTION COSINES ACCORDING TO W1,W2,W3;
REAL M3X,M3Y,M3Z; REAL M4X,M4Y,M4Z; REAL M5X,M5Y,M5Z;
REAL N3X,N3Y,N3Z; REAL N4X,N4Y,N4Z; REAL N5X,N5Y,N5Z;
REAL U3X,U3Y,U3Z; REAL U4X,U4Y,U4Z; REAL U5X,U5Y,U5Z;
REAL V3X,V3Y,V3Z; REAL V4X,V4Y,V4Z; REAL V5X,V5Y,V5Z;
REAL UX,UY,UZ; REAL VX,VY,VZ;
α INITIAL CAMERA RAY DIRECTION COSINES;
REAL M30X,M30Y,M30Z;
REAL M40X,M40Y,M40Z;
REAL M50X,M50Y,M50Z;
REAL N30X,N30Y,N30Z;
REAL N40X,N40Y,N40Z;
REAL N50X,N50Y,N50Z;
α PARAMETERS OF CLOSEST APPROACH BETWEEN CORRESPONDING SKEW RAYS;
REAL P,Q;
REAL F3X,F3Y,F3Z,D3;
REAL F4X,F4Y,F4Z,D4;
REAL F5X,F5Y,F5Z,D5;
REAL DW0,DW1,DW2,DW3;
SUBR ROTATE(REFERENCE REAL X,Y; REAL Q);
BEGIN "ROTATE"
REAL C,S,T;
C ← COS(Q); S ← SIN(Q);
T ← C*X - S*Y;
Y ← C*Y + S*X;
X ← T;
END "ROTATE";
SUBR MKCAMR; α COSINES BETWEEN CAMERA RAYS;
BEGIN "MKCAMR"
MC12 ← .8630286; NC12 ←.6801704; α TEST COSINES;
MC13 ← .9280318; NC13 ←.8939879;
MC14 ← .9504978; NC14 ←.8864540;
MC15 ← .8634228; NC15 ←.8354626;
MC23 ← .9674100; NC23 ←.9180645;
MC24 ← .9387822; NC24 ←.8159213;
MC25 ← .9958401; NC25 ←.9708753;
MC34 ← .9240093; NC34 ←.8619705;
MC35 ← .9805967; NC35 ←.9764107;
MC45 ← .9185642; NC45 ←.9068553;
MSIGN3 ← -1; MSIGN4 ← +1; MSIGN5 ← -1; α TEST SIGNS;
NSIGN3 ← -1; NSIGN4 ← +1; NSIGN5 ← +1;
α1 ← ACOS(MC12); MS12 ← SIN(α1);
α2 ← ACOS(NC12); NS12 ← SIN(α2);
SS1 ← MC12/MS12; RR1 ← 1/MS12;
SS2 ← NC12/NS12; RR2 ← 1/NS12;
α TEST SOLUTION;
C1X ← 3.628192; C1Y ← -.4830575; C1Z ← 0;
C2X ← 2.211233; C2Y ← .2988597; C2Z ←.4614799;
WW1 ← ATAN2(C1Y,C1X-SS1);
WW2 ← ASIN(C2Y/RR2);
WW3 ← ATAN2(-C2Z,C2X);
END "MKCAMR";
SUBR MKFORK; α INITIAL DIRECTION COSINES OF CAMERA RAYS;
BEGIN "MKFORK"
M30X ← -MC13;
M30Y ←-(MC23-MC12*MC13)/MS12;
M30Z ← MSIGN3*SQRT(1-M30X↑2-M30Y↑2);
M40X ← -MC14;
M40Y ←-(MC24-MC12*MC14)/MS12;
M40Z ← MSIGN4*SQRT(1-M40X↑2-M40Y↑2);
M50X ← -MC15;
M50Y ←-(MC25-MC12*MC15)/MS12;
M50Z ← MSIGN5*SQRT(1-M50X↑2-M50Y↑2);
N30X ← -NC13;
N30Y ←-(NC23-NC12*NC13)/NS12;
N30Z ← NSIGN3*SQRT(1-N30X↑2-N30Y↑2);
N40X ← -NC14;
N40Y ←-(NC24-NC12*NC14)/NS12;
N40Z ← NSIGN4*SQRT(1-N40X↑2-N40Y↑2);
N50X ← -NC15;
N50Y ←-(NC25-NC12*NC15)/NS12;
N50Z ← NSIGN5*SQRT(1-N50X↑2-N50Y↑2);
END "MKFORK";
SUBR SETFORK (REAL W1,W2,W3);
BEGIN "SETFORK"
REAL OM1,OM2;
α COPY THE INITIAL FORK VECTORS;
M3X ← M30X; M3Y ← M30Y; M3Z ← M30Z;
M4X ← M40X; M4Y ← M40Y; M4Z ← M40Z;
M5X ← M50X; M5Y ← M50Y; M5Z ← M50Z;
N3X ← N30X; N3Y ← N30Y; N3Z ← N30Z;
N4X ← N40X; N4Y ← N40Y; N4Z ← N40Z;
N5X ← N50X; N5Y ← N50Y; N5Z ← N50Z;
α FORK ORIENTATION ANGLES;
OM1 ← ATAN2(1-RR1*SIN(W1),SS1+RR1*COS(W1));
OM2 ← ATAN2(1-RR2*SIN(W2),SS2+RR2*COS(W2));
ROTATE(M3X,M3Y,-OM1); ROTATE(M4X,M4Y,-OM1); ROTATE(M5X,M5Y,-OM1);
ROTATE(N3X,N3Y,-OM2); ROTATE(N4X,N4Y,-OM2); ROTATE(N5X,N5Y,-OM2);
ROTATE(N3Z,N3X,W3); ROTATE(N4Z,N4X,W3); ROTATE(N5Z,N5X,W3);
α CAMERA LOCII;
UX ← SS1 + RR1*COS(W1);
UY ← RR1*SIN(W1);
UZ ← 0;
VX ← COS(W3)*(SS2 + RR2*COS(W2));
VY ← RR2*SIN(W2) ;
VZ ←-SIN(W3)*(SS2 + RR2*COS(W2));
END "SETFORK";
SUBR SKEW (REAL MX,MY,MZ,NX,NY,NZ);
BEGIN "SKEW"
REAL MN;
MN ← MX*NX + MY*NY + MZ*NZ;
P ← ((UX-VX)*(NX*MN-MX)
+(UY-VY)*(NY*MN-MY)
+(UZ-VZ)*(NZ*MN-MZ)) / (1-MN↑2);
Q ← ((UX-VX)*(NX-MN*MX)
+(UY-VY)*(NY-MN*MY)
+(UZ-VZ)*(NZ-MN*MZ)) / (1-MN↑2);
END "SKEW";
SUBR MKFORCE; α FIND CLOSEST POINTS OF CORRESPONDING SKEW RAYS;
BEGIN "MKFORCE"
SKEW(M3X,M3Y,M3Z,N3X,N3Y,N3Z);
U3X ← UX + P*M3X; V3X ← VX + Q*N3X;
U3Y ← UY + P*M3Y; V3Y ← VY + Q*N3Y;
U3Z ← UZ + P*M3Z; V3Z ← VZ + Q*N3Z;
SKEW(M4X,M4Y,M4Z,N4X,N4Y,N4Z);
U4X ← UX + P*M4X; V4X ← VX + Q*N4X;
U4Y ← UY + P*M4Y; V4Y ← VY + Q*N4Y;
U4Z ← UZ + P*M4Z; V4Z ← VZ + Q*N4Z;
SKEW(M5X,M5Y,M5Z,N5X,N5Y,N5Z);
U5X ← UX + P*M5X; V5X ← VX + Q*N5X;
U5Y ← UY + P*M5Y; V5Y ← VY + Q*N5Y;
U5Z ← UZ + P*M5Z; V5Z ← VZ + Q*N5Z;
α FORCE VECTORS;
F3X ← U3X-V3X; F3Y ← U3Y-V3Y; F3Z ← U3Z-V3Z;
F4X ← U4X-V4X; F4Y ← U4Y-V4Y; F4Z ← U4Z-V4Z;
F5X ← U5X-V5X; F5Y ← U5Y-V5Y; F5Z ← U5Z-V5Z;
α SEPARATION DISTANCE;
D3 ← SQRT(F3X↑2+F3Y↑2+F3Z↑2);
D4 ← SQRT(F4X↑2+F4Y↑2+F4Z↑2);
D5 ← SQRT(F5X↑2+F5Y↑2+F5Z↑2);
END "MKFORCE";
SUBR TORQUE (REAL W1,W2,W3);
BEGIN "TORQUE"
DW1 ← -F3X*U3Y + F3Y*(U3X-SS1)
-F4X*U4Y + F4Y*(U4X-SS1)
-F5X*U5Y + F5Y*(U5X-SS1);
DW2 ← -SIN(W3)*
(+F3Y*(V3Z+SS2*SIN(W3)) - F3Z*V3Y
+F4Y*(V4Z+SS2*SIN(W3)) - F4Z*V4Y
+F5Y*(V5Z+SS2*SIN(W3)) - F5Z*V5Y)
+COS(W3)*
(-F3X*(V3Z+SS2*SIN(W3)) + F3Z*(V3X-SS2*COS(W3))
-F4X*(V4Z+SS2*SIN(W3)) + F4Z*(V4X-SS2*COS(W3))
-F5X*(V5Z+SS2*SIN(W3)) + F5Z*(V5X-SS2*COS(W3)) );
DW3 ← + F3X*V3Z - F3Z*V3X
+ F4X*V4Z - F4Z*V4X
+ F5X*V5Z - F5Z*V5X;
DW0 ← SQRT (DW1↑2 + DW2↑2 + DW3↑2);
DW1 ← DW1/DW0;
DW2 ← DW2/DW0;
DW3 ← DW3/DW0;
END "TORQUE";
REAL SUBR QQ(REAL W1,W2,W3);
BEGIN "QQ"
SETFORK(W1,W2,W3);
MKFORCE;
RETURN(1/(1+D3+D4+D5));
END "QQ";
SUBR TORKUP;
BEGIN "TORKUP"
REAL W1,W2,W3; STRING STR;ITG CHR;REAL Q0,Q1,Q2,Q3,Q4,Q00;
REAL P0,P1,P2,P3,P4;REAL D1,D2;ITG I,J;
REAL K;
ITG IMAX;
OUTSTR("INITIAL GUESS & K ? ");
STR←INCHWL;
α W1←REALSCAN(STR,CHR)*π/180;
α W2←REALSCAN(STR,CHR)*π/180;
α W3←REALSCAN(STR,CHR)*π/180;
K←REALSCAN(STR,CHR);
IMAX←REALSCAN(STR,CHR);
W1←W2←W3←0;
Q0 ← QQ(W1,W2,W3);
FOR I←0 THRU IMAX DO
BEGIN
Q0 ← QQ(W1,W2,W3);
TORQUE(W1,W2,W3);
OUTSTR(CVS(I)&CVG(Q0)&CVG(K*DW1*180/π)&CVG(K*DW2*180/π)&CVG(K*DW3*180/π)&↓);
W1 ← W1-K*DW1; W2 ← W2-K*DW2; W3 ← W3-K*DW3;
END;
OUTSTR("W ANGLE'S: "&CVG(180*W1/π)&" "&CVG(180*W2/π)&" "&CVG(180*W3/π)&↓);
END "TORKUP";
SUBR CLIMB;
BEGIN "CLIMB"
REAL W1,W2,W3; STRING STR;ITG CHR;REAL Q0,Q1,Q2,Q3,Q4,Q00;
REAL P0,P1,P2,P3,P4;REAL D1,D2;ITG I,J;
OUTSTR("INITIAL GUESS ? ");
STR←INCHWL;
W1←REALSCAN(STR,CHR)*π/180;
W2←REALSCAN(STR,CHR)*π/180;
W3←REALSCAN(STR,CHR)*π/180;
D1 ← 1@-5;
D2 ← 1@3;
Q0 ← QQ(W1,W2,W3);
FOR I←0 THRU 300 DO
BEGIN
OUTSTR(CVS(I)&" "&CVG(Q0)&CVG(D2)&↓);
Q1 ← QQ(W1+D1,W2,W3)-Q0;
Q2 ← QQ(W1,W2+D1,W3)-Q0;
Q3 ← QQ(W1,W2,W3+D1)-Q0;
α SHORTEN THE STEP SIZE;
WHILE QQ(W1+D2*Q1,W2+D2*Q2,W3+D2*Q3)<Q0 DO
IF D2=0.1 THEN DONE ELSE D2 ← (D2*0.80 MAX 0.1);
IF D2=0.1 THEN
IF D1=1@-5 THEN ⊂ D1←1@-6; D2←1.0;⊃ ELSE
IF D1=1@-6 THEN ⊂ D1←1@-7; D2←1.0;⊃ ELSE DONE;
α LENGTHEN THE STEP SIZE;
IF D2<300 ∧ D2>0.1 THEN
WHILE Q0<(Q00←QQ(W1+1.2*D2*Q1,W2+1.2*D2*Q2,W3+1.2*D2*Q3)) DO
⊂ Q0←Q00;D2←D2*1.2;⊃;
Q0←QQ(W1←W1+D2*Q1,W2←W2+D2*Q2,W3←W3+D2*Q3);
END;
OUTSTR(CVS(I)&" "&CVG(Q0)&CVG(D2)&↓);
OUTSTR("W ANGLE'S: "&CVG(180*W1/π)&" "&CVG(180*W2/π)&" "&CVG(180*W3/π)&↓);
END "CLIMB";
PROCEDURE SAMPLER;
BEGIN "SAMPLER"
SAFE REAL ARRAY FN[-15:+15,-15:+15,-15:+15];
ITG I,J,K,IM,JM,KM;
REAL W1,W2,W3,QMAX,Q;
QMAX←0;
FOR K←-30 STEP 2 UNTIL 30 DO ⊂ W3 ← K*π/180;
FOR J←-30 STEP 2 UNTIL 30 DO ⊂ W2 ← J*π/180;
FOR I←-30 STEP 2 UNTIL 30 DO ⊂ W1 ← I*π/180;
Q←QQ(W1,W2,W3);FN[I/2,J/2,K/2]←Q;
IF Q>QMAX THEN ⊂ QMAX←Q;IM←I;JM←J;KM←K;
OUTSTR(CVG(QMAX)&" "&CVS(I)&" "&CVS(J)&" "&CVS(K)&↓);⊃;
⊃;⊃;⊃;
OPEN(1,"DSK",8,0,3,0,0,0);
ENTER(1,"FN3D",0);
ARRYOUT(1,FN[-15,-15,-15],31↑3);
RELEASE(1);
OUTSTR("DONE");INCHRW;
END "SAMPLER";
BEGIN "MAIN" α MAIN EXECUTION;
REAL Q0,W1,W2,W3;
ITG I,J,K;
MKCAMR;
MKFORK;
Q0 ← QQ(WW1,WW2,WW3);
OUTSTR("TEST SOLUTION: "&CVG(WW1)&CVG(WW2)&CVG(WW3)&↓);
OUTSTR(" QQ = "&CVG(Q0)&↓);
OUTSTR(" D3 = "&CVG(D3)&↓);
OUTSTR(" D4 = "&CVG(D4)&↓);
OUTSTR(" D5 = "&CVG(D5)&↓);
WHILE TRUE DO SAMPLER;
END "MAIN";
END "LS";